home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 19 / CU Amiga Magazine's Super CD-ROM 19 (1998)(EMAP Images)(GB)[!][issue 1998-02].iso / CUCD / Online / Apache / cgi-bin / wais.pl < prev   
Perl Script  |  1997-01-22  |  3KB  |  89 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # wais.pl -- WAIS search interface
  4. #
  5. # wais.pl,v 1.2 1994/04/10 05:33:29 robm Exp
  6. #
  7. # Tony Sanders <sanders@bsdi.com>, Nov 1993
  8. #
  9. # Example configuration (in local.conf):
  10. #     map topdir wais.pl &do_wais($top, $path, $query, "database", "title")
  11. #
  12.  
  13. $waisq = "/usr/local/bin/waisq";
  14. $waisd = "/u/Web/wais-sources";
  15. $src = "www";
  16. $title = "NCSA httpd documentation";
  17.  
  18. sub send_index {
  19.     print "Content-type: text/html\n\n";
  20.     
  21.     print "<HEAD>\n<TITLE>Index of ", $title, "</TITLE>\n</HEAD>\n";
  22.     print "<BODY>\n<H1>", $title, "</H1>\n";
  23.  
  24.     print "This is an index of the information on this server. Please\n";
  25.     print "type a query in the search dialog.\n<P>";
  26.     print "You may use compound searches, such as: <CODE>environment AND cgi</CODE>\n";
  27.     print "<ISINDEX>";
  28. }
  29.  
  30. sub do_wais {
  31. #    local($top, $path, $query, $src, $title) = @_;
  32.  
  33.     do { &'send_index; return; } unless defined @ARGV;
  34.     local(@query) = @ARGV;
  35.     local($pquery) = join(" ", @query);
  36.  
  37.     print "Content-type: text/html\n\n";
  38.  
  39.     open(WAISQ, "-|") || exec ($waisq, "-c", $waisd,
  40.                                 "-f", "-", "-S", "$src.src", "-g", @query);
  41.  
  42.     print "<HEAD>\n<TITLE>Search of ", $title, "</TITLE>\n</HEAD>\n";
  43.     print "<BODY>\n<H1>", $title, "</H1>\n";
  44.  
  45.     print "Index \`$src\' contains the following\n";
  46.     print "items relevant to \`$pquery\':<P>\n";
  47.     print "<DL>\n";
  48.  
  49.     local($hits, $score, $headline, $lines, $bytes, $type, $date);
  50.     while (<WAISQ>) {
  51.         /:score\s+(\d+)/ && ($score = $1);
  52.         /:number-of-lines\s+(\d+)/ && ($lines = $1);
  53.         /:number-of-bytes\s+(\d+)/ && ($bytes = $1);
  54.         /:type "(.*)"/ && ($type = $1);
  55.         /:headline "(.*)"/ && ($headline = $1);         # XXX
  56.         /:date "(\d+)"/ && ($date = $1, $hits++, &docdone);
  57.     }
  58.     close(WAISQ);
  59.     print "</DL>\n";
  60.  
  61.     if ($hits == 0) {
  62.         print "Nothing found.\n";
  63.     }
  64.     print "</BODY>\n";
  65. }
  66.  
  67. sub docdone {
  68.     if ($headline =~ /Search produced no result/) {
  69.         print "<HR>";
  70.         print $headline, "<P>\n<PRE>";
  71. # the following was &'safeopen
  72.         open(WAISCAT, "$waisd/$src.cat") || die "$src.cat: $!";
  73.         while (<WAISCAT>) {
  74.             s#(Catalog for database:)\s+.*#$1 <A HREF="/$top/$src.src">$src.src</A>#;
  75.             s#Headline:\s+(.*)#Headline: <A HREF="$1">$1</A>#;
  76.             print;
  77.         }
  78.         close(WAISCAT);
  79.         print "\n</PRE>\n";
  80.     } else {
  81.         print "<DT><A HREF=\"$headline\">$headline</A>\n";
  82.         print "<DD>Score: $score, Lines: $lines, Bytes: $bytes\n";
  83.     }
  84.     $score = $headline = $lines = $bytes = $type = $date = '';
  85. }
  86.  
  87. open (STDERR,"> /dev/null");
  88. eval '&do_wais';
  89.